COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	  
C00005 00003	(de runlab (a)(cond 
C00007 00004	(de condamne () 
C00009 00005	(de hau () (labc (eval (1 l4))(eval (2 l4)))) 
C00011 00006	(de declare (nom i j nom1 nom2) 
C00012 00007	 page display  
C00014 00008	(de displ (a y z) 
C00016 00009	 entree ------ 
C00018 00010	(de cadre (a) 
C00020 ENDMK
C⊗;
  
  ; FILE : LAA 13-Aug-78 14:09:13 ;

   
   (DE RUNBY (IND TER IMP I J K HB GD L1 L2 L4 DIR  SORTIE) 
	(if ind () (setq ni 0 nj 0))
      (escape *ex 
	 (setq l1 (copy '((decr i) j i (incr j) (incr i) j i (decr j))) 
	l2 (copy '((incr hb)(incr gd)(decr hb)(decr gd))) 
	l4 (copy '((1- i)   j i (1+ j) (1+ i) j i (1- j)))    
	dir (copy '(94 25 31 95))   
	sortie '/* 
	murs '(/| /_  /- /+) 
	hb 0 gd 0 k 0)
      (if ind ()       
      (PRINT "quelles dimensions (de la forme : x y (<= 10))")
      (SETQ NI (READ) NJ (READ))
	(declare 'labo ni nj 'labc 'labi)
      (DECLARE 'LAB NI NJ 'LABC 'LABI)
      (DECLARE 'L NI NJ 'LC 'LI)
	(cadre 'lab) 
	(setq xpos 5 ypos 10) 
	(init1)
	(displ 'lab)
	(setq xpos 5 ypos 10) 
	(print "donnez le labyrinthe s.v.p.")
	(print "(pour les murs utilisez les caracteres |,-)")
	(print "(← pour terminer, ↑ pour monter, # pour effacer)")
	(escape %ex (en1 2 2)))
      (PRINT "ou est le but ?")
      (SETQ REP1 (READ) REP2 (READ))
	(mapc '(labo l)(lambda (x) 
          (MAPARRAY x '(LAMBDA (-X) (SETA X -X (LAB -X))))))
      (SETQA LAB (LABI REP1 REP2) SORTIE)
      (SETQA L (LI REP1 REP2) SORTIE)
	(init)
	(setqa lab (labi i j) 0) 
	(setqa l (labi i j) 0)
	(tyi)         
      (setq oldi i oldj j)
	(runlab))))  
  
(de runlab (a)(cond 
	((sil-y-a 1 sortie (autour))(cestfini))  
	((sil-y-a 4 murs (autour)) (ttys 18 30 "IMPOSSIBLE")
		(cestfini))
	((sil-y-a 3 murs (autour)) 
		(if (sil-y-a 3 murs (cdr (autour))) 
			(progn (close)(vahau)) 
			(condamne))) 
	((neq (dro) 0)(if (eq (hau) 0)(vahau)(vagau))) 
	(t (vadro)))) 
 
(de vahau () 
	(ter)
	(impwith (car dir)) 
	(eval (1 l2)) 
	(testtour) 
	(eval (1 l1)) 
	(eval (2 l1)) 
	(runlab)) 
 
(de vadro () 
	(ter)
	(impwith (cadr dir))
	(eval (2 l2))
	(testtour)
	(eval (3 l1))
	(eval (4 l1))
	(setq 
		l1 (eg (eg l1)) 
		l2 (eg l2) 
		l4 (eg (eg l4)) 
		dir (eg dir)) 
	(runlab)) 
 
(de vagau () 
	(ter)
	(impwith (4 dir))
	(eval (4 l2))
	(testtour)
	(eval (7 l1))
	(eval (8 l1))
	(setq 
		l1 (ed (ed l1))
		l2 (ed l2)
		l4 (ed (ed l4))
		dir (ed dir))
	(runlab)) 
 
(de condamne () 
	(ter)
	(setq -x (combc (autour)))
	(close)
	(eval ((* -x 2) l1)) 
	(eval ((sub1 (* -x 2)) l1))
	(impwith (-x dir)) 
	(runlab))
 
(de close () (setq hb 0 gd 0 k 0) 
	     (setqa lab (labi i j) '/+)) 
 
(de cestfini (-x) 
	(ter)
	(impwith ((differ 5 (length (memq '/* (autour)))) dir))
	(display '(\177 \7)) 
	(print "j'l'ai eu") 
	(maparray 'labo (lambda (x)(setqa lab x (labo x))))
	(setq ter (mini ter)) 
	(while ter 
		(setqa labo (setq -x (apply 'labi (nextl ter)))(l -x)))
	(setq ypos (plus 20 ypos nj))
	(displ 'labo) 
	(setq ypos 10 xpos 5) 
	(tys)
	(print "vous en voulez plus ?") 
	(if (eq (tyi) \156) 
	    (progn 
		(ppiot 0 0)
		(display '(127 30)) 
		(run '(sys (kjob)))) 
            (ttys 18 30 "                 ")
	    (print "voulez vous utilisez l'ancien labyrinthe ?")
	    (setq ind (tyi))
	    (if (eq ind '\157) ()(setq ind nil))
	    (if ind ()
	    (ppiot 4 1) 
	    (ppiot 4 2) 
	    (ppiot 0 0))
	    (runby ind))) 
 
(de hau () (labc (eval (1 l4))(eval (2 l4)))) 
 
(de dro () (labc (eval (3 l4))(eval (4 l4)))) 
 
(de bas () (labc (eval (5 l4))(eval (6 l4)))) 
 
(de gau () (labc (eval (7 l4))(eval (8 l4)))) 
 
(de autour () [(hau)(dro)(bas)(gau)]) 
 
(de testtour () 
	(if (neq k 1) 
		(if (and (eq hb 0)(eq gd 0)) (setq k 1)) 
		(close))) 
 
(de sil-y-a (-x y ll) 
	(if (atom y) 
	    (eq (occur y ll) -x) 
	    (eq -x 
		(apply 'plus (mapcar y (lambda (-x) (occur -x ll))))))) 
 
(de ter () (newl ter [i j]))
 
(de pp (a -x y) 
	(if (memq (setq y (a -x)) '(31 95 25 94)) 
	    (ascii y) 
	    (if (eq y 0) '/   y))) 
 
(de occur (-x ll)(cond 
	((null ll) 0)
	((eq (nextl ll) -x) (add1 (self -x ll))) 
	(t (self -x ll)))) 
 
(de ed (ll) (append (last ll)(progn (rplacd (last ll 2)) ll))) 
 
(de eg (ll) (rplacd (last ll)(ncons (car ll))) (cdr ll)) 
 
(de declare (nom i j nom1 nom2) 
	(eval ['da [quote nom] (times i j) ''(lambda (-x) 0)])
	(eval ['de nom1 ['i 'j] 
		[nom ['/+ ['/* ['sub1 'i] j]['sub1 'j]]]])
	(eval ['de nom2 ['i 'j] 
		['/+ ['/* ['sub1 'i] j]['sub1 'j]]])) 
 
(de combc (ll) 
	(if ll 
	    (if (zerop (car ll)) 1 (add1 (self (cdr ll))))
	    (*ex "c'est impossible"))) 
 
(de min (-x l)(cond 
	((null l) ())
	((setq xx (member -x l))(min -x (cdr xx)))
	((null (cddr l))(cons -x l))
	(t (cons -x (min (car l)(cdr l)))))) 
 
(de mini (l) (min (car l)(cdr l))) 
 
; page display ; 
 
(de init1 () 
	(setq xpos 5 ypos 10) 
	(ppiot 0 131074)
	(ppiot 2 409)
	(ppiot 3 (+ (* 15 512) 1)) 
	; pp LISP : ;
	(ppiot 0 1)
	(ppiot 2 -305)
	(ppiot 3 (+ (* 3 512) 1))
	; activation ; 
	(ppiot 1 98304)
	(status 2 0 2))
 
(de init ()
	(displ 'lab)
	(setq ypos (plus 30 nj) xpos 5)
	(displ 'l)
	(setq xpos 5 ypos 10)
	(print "ou suis-je")
	(enter)
	(setq xpos 5 ypos 10)
  	(ttys (+ xpos i)(- (+ ypos (* 2 j)) 3) "o")
	(print "pour commencer tapez un caractere"))
 
(de ttys (-x y s ind) 
	(upgiot () (append [127 12 (logxor 96 y)(logxor 96 -x)]
		(mapcar (maklist s) 'cascii))))
 
(de impwith (-x) 
	(setqa l (li i j) -x)
	(ttys 6 (differ ypos 5)(reverstr (string [i '/| j])))
	(ttys (+ xpos oldi)(+ ypos (- (* 2 oldj) 2)) " ")
	(setq  oldi i oldj j)
	(ttys (+ xpos i)(+ ypos (- (* 2 j) 2)) 
		(string (ascii -x)))) 
 
(de displ (a y z) 
	(if (neq a 'lab) () 
	    (ttys 5 (- ypos 5) "_ _")
	    (ttys 6 (- ypos 6) "| | |")
	    (ttys 7 (- ypos 5) "- -"))
	(setq z 0)
	(ttys xpos ypos (reverstr (string (long nj))))
	(setq old '/ )
	(maparray a 
	  (lambda (-x) 
		(setq y (cons (setq new (pp a -x)) y))
		(newl y (cond 
			((memq new '(/-  /  /_ )) new)
			((eq new '/| )(cond 
				((eq old '/|) '/  )
				((eq old '/ ) '/  )
				((memq old '(/-  /_ )) 
 				    (if (zerop (rem -x nj)) '/   old)) 
				(t '/  )))   
			(t '/  )))
		(setq old new)
		(cond 
		   ((zerop (rem (add1 -x) nj)) 
			(ttys (incr xpos) ypos 
			(reverstr (string (cons (incr z)(cons '/    
				(rplaca y '/ ))))))
			(setq y ())))))) 
)))))))

 
(de long (-x)(if (zerop -x) () (mcons '/  -x (long (sub1 -x))))) 
 
; entree ------ ;
     
(de enter (%a)
	(setq %a 0)
	(setq oldxpos xpos)
	(ttyc (setq xpos(+ xpos 2)) (+ %a ypos))
	(e1)))))
 
(de e1 (%b)(cond 
	((eq (setq %b  (tyi)) \40)(ttyc xpos (+ ypos (setq %a (+ %a 2)))) 
		(e2))
	((eq %b \15)(setq %a 0)(ttyc xpos ypos)(e1))
	((eq %b \12)(ttyc (incr xpos) (+ ypos %a))(e1))
	((e1)))))))) 
 
(de e2 (%b)(cond   
	((eq (setq %b (tyi)) \40)(ttyc xpos (+ ypos (setq %a(+ %a 2))))
				(e2)) 
	((eq %b \177)(ttyc xpos (+ ypos (setq %a(- %a 2))))(e2)) 
	((eq %b \12)(ttyc (incr xpos) (+ ypos %a))(e2)) 
	((eq %b \15)(ttyc xpos (+ ypos (setq %a 0)))(e2)) 
	((eq %b \136)(ttyc (decr xpos)(+ ypos %a))(e2)) 
	(t (setq i (- xpos oldxpos) j (add1 (quo %a 2))) 
	   (print i j))))))))))))
 
(DE TTYC (X Y)
	; positionne le curseur en X et Y ;
	(PPIOT 8 (+ (STATUS 42 1)
		    (LOC (LOGOR (LOGSHIFT Y 18) X)))))))))
(de cadre (a) 
	(maparray a (lambda (x) (cond
		((lt x nj)(seta a x '/- ))
		((ge x (* (sub1 ni) nj)) (seta a x '/- )) 
		((or (zerop (rem x nj)) 
		     (eq (rem x nj) (sub1 nj))) 
			(seta a x '/| )) 
		(t (seta a x 0)))))) 
 
(de en1 (i j %b) 
  (if (ge i ni) (ex)) 
  (ttyc1 i j)
  (setq %b (tyi)) (cond 
	((eq %b \40)(avance)(ttyc1 i j)(en1 i j)) 
	((eq %b \12)(setq i (add1 i))(ttyc1 i j)(en1 i j)) 
	((eq %b \15)(setq j 2)(ttyc1 i j)(en1 i j)) 
	((eq %b \174)(tyo1 %b)(puta i j) 
				(avance)(ttyc1 i j)(en1 i j)) 
	((eq %b \55) (puta i j)(tyo1 %b)(incr j)(tyo1 %b)(incr j)
			(if (ge j (* 2 nj))(setq j 2)) 
			(ttyc1 i j)(en1 i j)) 
	((eq %b \136)(decr i)(ttyc1 i j)(en1 i j)) 
	((eq %b \137)(ttyc 21 3)) 
	((eq %b \177)(setq j (- j 2))(ttyc1 i j)(en1 i j)) 
	((eq %b \43)(setq %b \60)(puta i j)
			(tyo1 \40)(incr j)(tyo1 \40)(incr j)  
			(ttyc1 i j)(en1 i j))  
	(t (en1 i j))))))))) 
 
(de tyo1 (%b)(upgiot () [127 12 (logxor 96 (+ ypos j)) 
			(logxor 96 (+ xpos i)) %b])))))  
 
(de ttyc1 (i j)(ttyc (+ xpos i)(+ ypos j))) 
 
(de avance () 
	(if (ge (setq j (+ j 2))(* nj 2))(setq j 2))) 
 
(de puta (i j)(setqa lab (labi i (add1 (quo j 2)))(ascii %b))))